home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / aplibs91.zip / HBDEMO.BAS < prev    next >
BASIC Source File  |  1991-07-02  |  64KB  |  1,819 lines
  1.  
  2. '             ╔═════════════════════════════════════════════╗
  3. '             ║    THE NEW HB ALL-PURPOSE LIBRARY DEMO      ║
  4. '             ║        FOR POWER-BASIC PROGRAMMERS          ║
  5. '             ║           SPRING / SUMMER  1990             ║
  6. '             ║           Ver 2.5a, SPRING  '91             ║
  7. '             ╚═════════════════════════════════════════════╝
  8.  
  9. '                            ┌─────────────────────────┐
  10. '                            │ TO CREATE THIS DEMO OF  │
  11. '    L O O K  ======== >>>   │ THE APLIB ROUTINES JUST │
  12. '               :)           │ TYPE "makedemo" FROM    │
  13. '                            │ THE COMMAND LINE !      │
  14. '                            └─────────────────────────┘
  15.  
  16. '        NOTE: Due to wanting this to fit in one 64 K. source file, I'm
  17. '              removing some comments and advice lines. See doc file.
  18.  
  19.                            $COMPILE EXE
  20.                            $LIB LPT ON,_
  21.                                 COM OFF, GRAPH OFF, FULLFLOAT OFF, IPRINT OFF
  22.                            $STACK 3072
  23.                            $ERROR ALL ON
  24.                            $OPTION CNTLBREAK ON
  25.  
  26.  %ScrnStackSize = 12
  27.  
  28. '  Correct order: DIM Statements, $LINK statements, then PUBLIC statements.
  29.  
  30.                            $INCLUDE "APLIB-H.BAS"
  31.  
  32. '                 ---------  DEFAULT COLORS ---------
  33.  %MonoMenu =  %Blk + %Background * %Gry:  %ColorMenu = %Wht + %Background * %Blu
  34.  %MonoBar  =  %Gry + %Background * %Blk:  %ColorBar  = %Ylo + %Background * %Red
  35.  %MonoWin  =  %Gry + %Background * %Blk:  %ColorWin  = %Blu + %Background * %Gry
  36.  %MonoFld  =  %Blk + %Background * %Gry:  %ColorFld  = %Ylo + %Background * %Red
  37.  %MonoBox  =  %Wht + %Background * %Blk:  %ColorBox  = %Wht + %Background * %Grn
  38.  %MonoScr  =  %Gry + %Background * %Blk:  %ColorScr  = %Cyn + %Background * %Blk
  39. '                ------------------------------------
  40.                            $LINK "INIT-U.PBU"
  41.                            $LINK "FENTRY-U.PBU"
  42.                            $LINK "FIGDAT-U.PBU"
  43.                            $LINK "BOXES-U.PBU"
  44.                            $LINK "MENUS-U.PBU"
  45.                            $LINK "MISC-U.PBU"
  46.                            $LINK "NEW-U.PBU"
  47.  
  48.                            $INCLUDE "HBDEMO.PV"
  49.  
  50. '                                        The *.PV files are lists of all the
  51. '                                        public variables in a program's units.
  52. '                                        Any time you change the EXTERNAL
  53. '                                        variables in your units, run
  54. '                                        PUBVARS.EXE and you will get a fresh,
  55. '                                        sorted list to include in the main
  56. '                                        file, like this.
  57.  SourceFile$ = "HBDEMO.BAS"
  58.  SourceDir$ = "." '                          set up error handling
  59.  RDisk$ = ENVIRON$ ("TEMP") + ":" '     ┌──────────────────────────────────────┐
  60.  GoToSourceFile = %False '      <───────┤ If you use QEdit, set this var as    │
  61.  ON ERROR GOTO Oops '                   │ %True and you'll get automatic       │
  62.  '                                      │ search for runtime errors when       │
  63.  '                                      │ working from the command line --     │
  64.  '                                      │ just like you do in the PB environm't│
  65.  '                                      └──────────────────────────────────────┘
  66.  UsingButtons = %True
  67.  LocalAreaCode$ = "415"
  68.  Item% = 101 '                           (starting # for demo checkbook entries)
  69.  
  70.  CALL Initialize (%StarNX1000) '       see INIT-U.BAS for other printers
  71. '                                         
  72.  HomeDirec$ = CURDIR$ ("")
  73.  HomeDrive$ = GetCurrentDrive$
  74.  
  75. '     =============================================== TITLE SCREEN
  76.  
  77.  TopOfButtons = 19
  78.  
  79.  DIM DYNAMIC ButtonMsg$ (1:5, 1:3)
  80.  DIM DYNAMIC Key2Alt (1:8)
  81.  
  82.  ButtonMsg$ (1,1) = "  Open"
  83.  ButtonMsg$ (1,2) = "  QEDIT"
  84.  ButtonMsg$ (1,3) = "  Alt-A"
  85.  Key2Alt (1) = 30 '                                   these are in QWERTY order
  86.  
  87.  ButtonMsg$ (2,1) = "DIRECTORY"
  88.  ButtonMsg$ (2,2) = " MANAGER"
  89.  ButtonMsg$ (2,3) = "  Alt-D"
  90.  Key2Alt (2) = 32
  91.  
  92.  ButtonMsg$ (3,1) = "set mouse"
  93.  ButtonMsg$ (3,2) = " sens."
  94.  ButtonMsg$ (3,3) = " Alt-M"
  95.  Key2Alt (3) = 50
  96.  
  97.  ButtonMsg$ (4,1) = " EXIT to"
  98.  ButtonMsg$ (4,2) = "   DOS"
  99.  ButtonMsg$ (4,3) = " Alt-X"
  100.  Key2Alt (4) = 45
  101.  
  102.  Buttons% = 4
  103.  
  104.  
  105.  GOSUB SetColors
  106.  COLOR ScrColor MOD 16, ScrColor \ 16 '    This breaks down an integer color
  107.  
  108.         '                                          attribute into foreground & backgrd
  109.  CLS
  110.  GOSUB Logo3 '                                print a title in a box on screen
  111.  COLOR ScrColor MOD 16, ScrColor \ 16
  112. '                                              and next, open a Static Window
  113. '     (displays some data at run-time but doesn't let the user enter any) and
  114. '     displays some disk and system info in it.
  115.  
  116. ' ===========================================================================
  117.  
  118. '          USE OF THE                            SWW.EXE is a screen generator
  119. '        STATIC WINDOW                           and by processing DEMO.SW
  120. '        PAINT UTILITY                           gives the BASIC statements in
  121. '           SWW.EXE                              these lines to draw window
  122. '                                                and set up its static fields.
  123. '                                                The template files are similar
  124. '                                                to those use to make POPWINDOW
  125. '                                                designs, as described below.
  126. '                                                See OPENDEMO.SW for an example.
  127. ' ===========================================================================
  128.  
  129.                       $INCLUDE "opendemo.inc"
  130.  
  131.  COLOR ScrColor MOD 16, ScrColor \ 16
  132.  LOCATE 24, 41: PRINT "note: use a mouse if you wish. L = yes.";
  133.  
  134.  COLOR BarColor MOD 16, BarColor \ 16
  135.  LOCATE 25,1: CALL ClearLine '        SUB ClearLine erases screen from cursor
  136. '                                     position all the way to rt edge of scrn
  137.  PRINT "     SOUND ON ?? ";
  138.  SoundOn = GetYesOrNo '                 FUNCTION GetYesOrNo simply writes a
  139. '                                       "(y/n)" prompt to the screen and then
  140. '                                       awaits the user's pleasure. It is case
  141. '                                       insensitive & also Mousable. (L = Yes.)
  142.  GOSUB SetBeeps
  143.  If SoundOn THEN PLAY ArribaBeep$
  144.  Choice = 256 '                                   We don't want Choice, the
  145. '     menu return value, to be 0 at the start. A Choice value of 0 is used
  146. '     for a specific purpose: it means [Esc] was pressed in reponse to a
  147. '     pull-down menu.
  148.  
  149. ' ==================================== PRINT MAIN MENU -- A BAR ACROSS TOP
  150. MainMenu:
  151.  
  152.  CHDRIVE (HomeDrive$)
  153.  CHDIR (HomeDirec$)
  154.  
  155.  GOSUB SetColors '                                 set colors based on defaults
  156.  COLOR ScrColor MOD 16, ScrColor \ 16 '               or command line switches.
  157.  CLS
  158.  NextScrn2Pop = 1 '                          Reset the screen stack pointer
  159. '                                            to 1. At this point the
  160. '                                            next screen we "push" (save) will
  161. '                                            be numbered 2 (I'm not using an 0)
  162.  LOCATE 24,1: GOSUB WipeLn
  163.  PRINT F1Help$;
  164.  
  165. ' =============================================================================
  166. '
  167. '       How to use "TOPMENU ()" -- The Horizontal Main Menu Procedure --
  168. '        -----------------------------------------------------------
  169. '
  170. '    This procedure writes a list of choices across the top of the screen and
  171. '    allows the user to select from them by one of three methods: (1) Press the
  172. '    first letter of the desired choice (note that you can't have two choices
  173. '    starting with the same letter!) or (2) use the cursor arrows to highlight
  174. '    your choice and then press Enter (CR), or (3) if you have a Furry Friend,
  175. '    just click on your choice with the left button. (This is pretty much the
  176. '    way people expect a menu to behave!)
  177. '
  178. '    Set it up with a DATA list of selection titles like the one following --
  179. '    follow w/ DATA END; don't forget to RESTORE to the label above the list.
  180. '    you can use less than a three line menu (to save screen space) but
  181. '    frankly I haven't used 2-line or 1-line TOPMENU's enough to even know
  182. '    whether they have bugs, so just use 3 for now. T$ should be the menu
  183. '    title if you want one, and after the CALL returns, will be set to the
  184. '    string chosen by the user or "HELP!" if F1 pressed. Mostly I just branch
  185. '    the program on the basis of TChoice, an integer showing which selection
  186. '    was made.
  187. ' =============================================================================
  188.  
  189.  IF Choice > 0 THEN '  unless user has just backed out of a menu w/o selecting,
  190.    TChoice = 1 '                  the return variable Choice will be > 0 and
  191.    GOSUB Logo2 '                     the main menu will be reset to choice #1
  192.  END IF
  193.  TimeOut = 10
  194.  T$ = " HB's PowerBASIC Routines Library: the Demo " '            menu title
  195.  
  196.  If SoundOn THEN PLAY LookitBeep$
  197.  
  198.  DATA "POPWINDOW DEMO","FILES","MENUS & BOXES","OTHER DEMOS","QUIT/CONFIG"
  199.  DATA END
  200.  NumberOfLines = 3
  201.  DO
  202.   RESTORE MainMenu
  203.  
  204.              CALL TOPMENU (NumberOfLines, TChoice, T$)
  205.  
  206.   IF T$ = "HELP!" THEN
  207.     RESTORE MainMenuHelp
  208.     GOSUB HelpWindow
  209.   END IF
  210.  
  211.  LOOP UNTIL T$ <> "HELP!"
  212.  CALL SCREENPUSH '                      save this screen to memory ...
  213.  
  214.  MainMenuScreen = NextScrn2Pop '          make a note of what number it is ...
  215.  
  216.  SELECT CASE ButtonActive
  217.    CASE 0
  218.      IF TimeOut THEN GOTO ScreenBlank
  219.      ON TChoice GOTO OpenEntryWindow, FileSubmenu, MenuDemo,_
  220.                                                      MiscDemos, QuitSubMenu
  221.    CASE 4
  222.      COLOR ScrColor MOD 16, ScrColor \ 16
  223.      CLS
  224.      CALL CloseFiles
  225.      CALL RestoreDOSScreen
  226.      END
  227.    CASE 3
  228.      CALL MouseControl (0, 0)
  229.      GOTO MainMenu
  230.    CASE ELSE
  231.      CALL QBox (20, %Center, 1, "YOU PICKED BUTTON " + STR$(ButtonActive), 0)
  232.      DELAY .5
  233.      CALL PressAKey
  234.      GOTO MainMenu
  235.  END SELECT
  236.  
  237.  
  238. '  ------------------ MAIN MENU CHOICE # 2: FILE SUBMENU ------------------
  239.  
  240. FileSubmenu:
  241. ' ============================================================================
  242.  
  243. ' Notes:              *** HOW TO USE: SUPERMENU () ***
  244. '                           ===================
  245. '
  246. 'Syntax:
  247. 'CALL SUPERMENU (MenuData$(), MenuRight, MenuDown, Choice, Title$, KeyPressed)
  248. '
  249. '
  250. '  MENU SETUP: THE MenuData$ ARRAY:
  251. '     Each choice on your menu is represented by one string element in
  252. '     this array. The decription of each choice -- for example, "LOAD",
  253. '     will start with the third character of this string. If you are
  254. '     specifying the hot-key for each choice put it into the first
  255. '     character -- set MenuData$ (1) as something like "L LOAD". To let
  256. '     the software number or letter the items in order for you, set
  257. '     MenuData$ as just "  LOAD". (If there are <10 items, numbers
  258. '     are used rather than letters.) After the last menu item, you
  259. '     must set the next array element as "END".
  260. '  PASSING HELP LINES TO MENU: Set MenuHelpLine$() to contain lines (up
  261. '     to 80 chr long) to appear at screen bottom whenever the
  262. '     corresponding menu choice is highlighted.
  263. '  POSITION OF MENU ONSCREEN ETC.: MenuRight moves it right or left --
  264. '     MenuDown moves it -- you guessed it! 0,0 is top center. Errors are
  265. '     trapped. Vertical centering is gotten by setting MenuDown = 25.
  266. '     Usually set Choice = 1.  Title$ is title of menu.
  267.  
  268. ' *** AFTER MENU ROUTINE: Choice will hold the choice #. Title$ reset to "".
  269. '     MKeyPressed$ = the actual key used (if L. Mousebutton was used it
  270. '     simulates the CR key, i.e. CHR$(13)) -- or if [ESC] or a legal
  271. '     function key was pressed it contains "ESC", "PgDn", "PgUp", "F1",
  272. '     or "F2". (Right Mousebutton = "ESC".)
  273. ' ============================================================================
  274.  
  275.  MenuData$(1) = "F Directory"
  276.  MenuData$(2) = "V View .BAS"
  277.  MenuData$(3) = "D View .DOC"
  278.  MenuData$(4) = "P Print DOC file"
  279.  MenuData$(5) = "C Copy files"
  280.  MenuData$(6) = "O Shell to DOS"
  281.  MenuData$(7) = "END"
  282.  MenuHelpLine$ (1) =_
  283.       "Using CALL DirFirst & DirNext (SUB's that get info direct from DOS)"
  284.  MenuHelpLine$ (2) = "this lets you read the source file HBDEMO.BAS"
  285.  MenuHelpLine$ (3) =_
  286.       "this lets you display the documentation accompanying HBLib"
  287.  MenuHelpLine$ (5) = "here a dummy function"
  288.  MenuHelpLine$ (6) = "this works -- if it can find COMMAND.COM & load it ..."
  289.  
  290.  Title$ = ""
  291.  Choice = 1
  292.  PullDown = %Yes '                  Make this a pulldown supermenu ...
  293.  UseRArrow = %Yes '                 We want to be able to drag it either
  294.  UseLArrow = %Yes '                   rt or left with arrow keys or rodent ...
  295.  MenuRight = -15
  296.  MenuDown = 2
  297.  
  298.    CALL SUPERMENU (MenuData$(), MenuRight, MenuDown,_
  299.                                                 Choice, Title$, KeyPressed)
  300.  
  301.  DECR NextScrn2Pop '                   we won't need to pop the previous screen
  302.  
  303.  IF KeyPressed = %F1 THEN GOSUB MenuHelpScrn: GOTO FileSubMenu
  304.  IF KeyPressed = %LArrow THEN GOSUB MZap: GOTO OpenEntryWindow
  305.  IF KeyPressed = %RArrow THEN GOSUB MZap: GOTO MenuDemo
  306.  IF Choice = 0 THEN MainMenu
  307.  
  308.  SELECT CASE LEFT$ (MenuData$ (Choice), 1)
  309.    CASE "F"
  310.      GOSUB Directory
  311.      GOTO MainMenu
  312.    CASE "V", "D"
  313.     If SoundOn THEN PLAY LookitBeep$
  314.      IF ColorDisplay THEN Color %Wht, %Blu ELSE COLOR %Gry, %Blk
  315.      CLS
  316.      IF Choice = 3 THEN File2View$ ="APLIB.DOC" ELSE File2View$ = "HBDEMO.BAS"
  317.      IF EXIST (File2View$) THEN '              uses function EXIST () ...
  318.        TxtFile = FREEFILE '                    gets an available handle # ...
  319.        OPEN File2View$  FOR INPUT AS #TxtFile
  320.        Ln = 0
  321.        DO UNTIL EOF (TxtFile) OR FileError '             and views the file.
  322.          LINE INPUT #1, L$
  323.          INCR Ln
  324.          IF ColorDisplay THEN COLOR %Wht, %Blu ELSE COLOR %Gry, %Blk
  325.          PRINT LEFT$ (L$, 79)
  326.          IF CSRLIN = 23 THEN
  327.            IF ColorDisplay THEN Color %Blu, %Vlt ELSE COLOR %Blk, %Gry
  328.            PRINT STRING$ (80, 205);
  329.            CALL ClearLine
  330.            PRINT "  WORLD'S MOST PRIMITIVE FILE VIEWER:  File ";
  331.            PRINT File2View$; ",  LINE "; Ln-21;
  332.            LOCATE 25,1, 0
  333.            CALL ClearLine
  334.            PRINT " PRESS [ESC] TO EXIT, [PG-UP] TO GO BACK TO LINE 1, ";
  335.            PRINT "ANY OTHER KEY TO GO ON";
  336.            DO: LOOP UNTIL INSTAT
  337.            K$ = INKEY$
  338.            IF K$ = CHR$ (27) THEN EXIT LOOP
  339.            IF K$ = CHR$ (0) + CHR$ (&H49) THEN
  340.              If SoundOn THEN PLAY TinyBeep$
  341.              CLOSE #TxtFile
  342.              OPEN File2View$  FOR INPUT AS #TxtFile
  343.              Ln = 0
  344.            END IF
  345.            IF ColorDisplay THEN COLOR %Wht, %Blu ELSE COLOR %Gry, %Blk
  346.            FOR N = 1 TO 22: LOCATE N, 1: CALL ClearLine: NEXT: LOCATE 1,1
  347.          END IF
  348.        LOOP
  349.        IF SoundOn THEN PLAY ArribaBeep$
  350.        CLOSE #1
  351.      ELSE
  352.        Msg$ = "DID NOT FIND FILE " + GetCurrentDir$ ("") + "\" + File2View$
  353.        CALL QBox (10, 20, 1, Msg$ , 0)
  354.  
  355. '                                 QBox was written to put little dialog boxes
  356. '   onscreen -- but it turns out to very handy as a message box as well. This
  357. '   will print a box at position 10, 20 with this string in it and an answer
  358. '   field length of zero.
  359.  
  360.  
  361.        CALL PressAKey '             Little box says Press Any Key ... if mouse
  362.      END IF '                       present it also suggests a click.
  363.      EXIT SELECT
  364.    CASE "O"
  365.      If SoundOn THEN PLAY LookitBeep$
  366.      IF ColorDisplay THEN COLOR %Ylo, %Red ELSE COLOR %Blk, %Gry
  367.      CLS
  368.      LOCATE 2,12: PRINT "TYPE `EXIT' TO RETURN TO PROGRAM"
  369.      SHELL
  370.      GOTO MainMenu
  371.    CASE "P"
  372.      GOSUB PrintDoc
  373.      GOTO MainMenu
  374.    CASE ELSE
  375.      GOTO FakeFunction
  376.  END SELECT
  377.  GOTO MainMenu
  378.  
  379. '  -------------------- MAIN MENU CHOICE #3: MENU DEMOS ----------------
  380.  
  381. MenuDemo:
  382.  
  383.  
  384.  MenuData$ (1) = "   Demo of MESSAGEBOX"
  385.  MenuData$ (2) = "   Demo of QBOX"
  386.  MenuData$ (3) = "   Demo of SUPERMENU"
  387.  MenuData$ (4) = "   Hundred Items Menu"
  388.  MenuData$ (5) = "   Menu of Files"
  389.  MenuData$ (6) = "END"
  390.  
  391.  Choice = 1
  392.  PullDown = %Yes
  393.  UseRArrow = %Yes
  394.  UseLArrow = %Yes
  395.  
  396.      CALL SUPERMENU (MenuData$ (), 0, 2, Choice, "", KeyPressed)
  397.  
  398.  DECR NextScrn2Pop
  399.  IF KeyPressed = %Esc THEN MainMenu
  400.  IF KeyPressed = %F1 THEN GOSUB MenuHelpScrn: GOTO MenuDemo
  401.  IF KeyPressed = %LArrow THEN GOSUB MZap: GOTO FileSubMenu
  402.  IF KeyPressed = %RArrow THEN GOSUB MZap: GOTO MiscDemos
  403.  ON Choice GOSUB MessageBoxTest, QBoxTest, MoveAMenuII,_
  404.                                   HundredItemsMenu, MOFiles
  405. '           NOTE: if [Esc] was pressed, Choice = 0 and there's no GOSUB at all.
  406.  GOTO MainMenu
  407.  
  408.  
  409. '   ==================== MAIN MENU CHOICE # 4 -- MISC. SUBMENU
  410.  
  411. MiscDemos:
  412.                                ' set up menu lines & help lines ...
  413.  
  414.  MenuData$ (1) = "  ENTRY MODES" '            note that for this menu I've
  415.  MenuData$ (2) = "  DATE ARITHMETIC" '        left two spaces in front of
  416.  MenuData$ (3) = "  BEEPS" '                  each choice. SUPERMENU will
  417.  MenuData$ (4) = "  END" '                    number them (or letter if > 9)
  418.  
  419.  MenuHelpLine$ (1) = "many different types of line entries demonstrated"
  420.  MenuHelpLine$ (2) = "the all-knowing machine will tell you your age ..."
  421.  MenuHelpLine$ (3) =_
  422.      "this is a test-bed to invent, hear and save your own favorite Beeps ..."
  423.  
  424.  MenuRight = 18              ' locate menu ...
  425.  MenuDown = 2
  426.  Choice = 1                 ' start with first item highlighted ...
  427.  Title$ = ""                 ' no title ...
  428.  Choice = 1
  429.  UseRArrow = %Yes
  430.  UseLArrow = %Yes
  431.  PullDown = %Yes
  432.  
  433.  CALL SUPERMENU (MenuData$(), MenuRight, MenuDown, Choice, Title$, KeyPressed)
  434.  
  435.  DECR NextScrn2Pop '                   we won't need to pop the previous screen
  436.  IF KeyPressed = %Esc THEN MainMenu
  437.  IF KeyPressed = %F1 THEN GOSUB MenuHelpScrn: GOTO MiscDemos
  438.  IF KeyPressed = %LArrow THEN GOSUB MZap: GOTO MenuDemo
  439.  IF KeyPressed = %RArrow THEN GOSUB MZap: GOTO QuitSubMenu
  440.  
  441.  ON Choice GOSUB EnterDemo, DateTest, BeepTest
  442.  GOTO MainMenu
  443.  
  444.  
  445. QuitSubMenu: '  ====================== MAIN MENU CHOICE #5: QUIT
  446.  
  447.  MenuData$ (1) = "Y Exit to DOS"
  448.  
  449.  IF SoundOn THEN
  450.    MenuData$ (2) = "S Sound Off"
  451.  ELSE
  452.    MenuData$ (2) = "S Sound On"
  453.  END IF
  454.  
  455.  MenuData$ (3) = "E Fake ERROR"
  456.  MenuData$ (4) = "N Cancel"
  457.  MenuData$ (5) = "END"
  458.  
  459.  MenuHelpLine$ (3) = "force an error just to see the error handling routine"
  460.  MenuHelpLine$ (4) = "don't quit after all ... "
  461.  
  462.  Title$ = ""
  463.  Choice = 1
  464.  PullDown = %Yes
  465.  UseLArrow = %Yes
  466.  
  467.        CALL SUPERMENU (MenuData$(), 40, 2, Choice, Title$, KeyPressed)
  468.  
  469.  DECR NextScrn2Pop '                   we won't need to pop the previous screen
  470.  IF KeyPressed = %Esc THEN MainMenu
  471.  IF KeyPressed = %F1 THEN GOSUB MenuHelpScrn: GOTO QuitSubMenu
  472.  IF KeyPressed = %LArrow THEN GOSUB MZap: GOTO MiscDemos
  473.  
  474.  If SoundOn THEN PLAY LookitBeep$
  475.  
  476.  
  477.  IF CHOICE = 0 THEN
  478.    CALL SCREENPOP
  479.    GOTO MainMenu
  480.  ELSE
  481.    IF LEFT$ (MenuData$ (Choice), 1) <> "E" THEN COLOR 0,0:CLS:DECR NextScrn2Pop
  482.  END IF
  483.  IF Choice <> 0 THEN OldChoice = 1
  484.  
  485.  SELECT CASE LEFT$ (MenuData$ (Choice), 1)
  486.    CASE "Y"
  487. LastScrn:
  488.      CLS
  489.      CALL CloseFiles '        Take care of writing database files back if any...
  490.      DELAY 0.5
  491.      ON ERROR GOTO HarmlessError
  492.      CALL RestoreDOSScreen '      restore screen that was there to begin with;
  493.      LOCATE ,,0
  494.  
  495. '                                   write a boxed Farewell Message on top
  496. '                                   of the restored screen -- really
  497. '                                   impress 'em!
  498.  
  499.      DATA "Thank you for using", "the HB Library DEMO",""
  500.      DATA Program ends., Press something.
  501.      DATA END
  502. '                                         ===================================
  503. '                                         USING BOXMESSAGE ():
  504. '                                         You need a DATA list like this;
  505. '                                         use a RESTORE statement so the
  506. '                                         runtime system can find it;
  507.      RESTORE LastScrn '                   set the margin ...
  508.      Margin = 1 '                         set CornerLin & CornerCol or use
  509.      If SoundOn THEN PLAY TaskBeep$ '     %Center as we do here to center the
  510.      CALL SCREENPUSH '                    window ... and it's ready.
  511. '                                         ===================================
  512.  
  513.        CALL BOXMESSAGE (%Center, %Center, Margin)
  514.  
  515.      GOSUB ClickOrStrike
  516.      CALL SCREENPOP '               erase the box and return control to DOS.
  517.      LOCATE OrigL, 1
  518.      END '                             ================>> EXIT POINT
  519.  
  520.    CASE "S"
  521.      SoundOn = NOT SoundOn
  522.  
  523.    CASE "E"
  524.    ErrorMessage$ = "fake error generated from HBDEMO menus"
  525.     DO
  526.       CALL SCREENPUSH
  527.       EType$ = " "
  528.       CALL QBox_
  529.         (5,10,1,"D for DOS ERROR, P for PRINTER ERROR, O for OTHER ERROR ", 2)
  530.       COLOR FldColor MOD 16, FldColor \ 16
  531.       Msg$ = "AutoCap"
  532.       FieldSize = 1
  533.  
  534.         CALL ENTERSTRING (EType$, FieldSize, Msg$)
  535.  
  536. ' =============================================================================
  537.  
  538. '                How to use SUB ENTERSTRING (Wkg$,FLength,Msg$)
  539. '                  ----------------------------------------
  540.  
  541. '   This routine provides a field at current corsor loc for the operator to
  542. '   enter data into. Wkg$ is the current value of the field. FLength = length
  543. '   of field. Msg$ may be "" or may hold the strings "Cap" for all uppercase,
  544. '   "Auto" for automatic entry when full, "UpOut" or "BackOut" if UpArrow or
  545. '   Left/ backspace keys are to be able to end entry. Tab and ShfTab also
  546. '   work.
  547. '
  548. '   On exiting sub, Msg$ may be reset as Left, Auto, Up, Down, ESC or CR. At
  549. '   any time during string entry the operator can press [CR] or DOWN- ARROW
  550. '   to enter;  [F2] is pressed for Database Function commands (Clear, Find,
  551. '   Next/Prev, View Notes, Save) implemented (see SUB FileFunctions)
  552. '
  553. '   2-4-89: Now supports:  ^Y, ^T, and ^Arrow. Negative numbers not allowed
  554. '   unless Msg$ includes a "-" InsertStatus is a global.
  555.  
  556. '   N.B.: OF COURSE THIS IS JUST A ONE-CHR STRING TO ENTER. I PUT THE DOC
  557. '         BLOCK HERE 'CAUSE IT'S THE  F I R S T  INSTANCE OF THIS CALL. 
  558. '         THERE ARE MANY MORE-TYPICAL EXAMPLES TO FOLLOW ...
  559. ' ===========================================================================
  560.  
  561.       CALL SCREENPOP
  562.     LOOP UNTIL EType$ = "O" OR EType$ = "P" OR EType$ = "D" OR Msg$ = "ESC"
  563.     ON ERROR GOTO Oops
  564.     IF Msg$ = "ESC" THEN MainMenu
  565.     SELECT CASE EType$
  566.       CASE "O"
  567.         ERROR 5
  568.       CASE "D"
  569.         JustDemonstratingOops = %True
  570.         ERROR 53
  571.         EXIT SELECT
  572.       CASE ELSE
  573.         ERROR 27
  574.     END SELECT
  575.   END SELECT
  576.   GOTO MainMenu '  here end the various pulldown menus. Next come major
  577. '    routines ... Starting with OpenEntryWindow (lifted, as you might guess,
  578. '    from my personal custom Checkbook Program).
  579.  
  580. OpenEntryWindow:
  581.  
  582. '===============================================================================
  583. '    ABOUT POPWINDOWS:
  584. '    Here's how to create a window for data entry like the one demonstrated
  585. '    here: (1) Create a plain-ASCII template file for your window and name
  586. '              it like WHATEVER.PW (See PWDEMO.PW for a sample).
  587. '          (2) Draw out the top and left side of the window box using the
  588. '              carat (^^^) symbol. Type in the field titles and then use a
  589. '              left bracket ("{") to show where you want each data entry field
  590. '              to start.
  591. '          (3) Under that type a backslash ("\") at the left margin, followed
  592. '              by a list of the following: First your name for the field, then
  593. '              a comma, and then IN QUOTES the mask string you want to use for
  594. '              the data in your field (according to the rules for the
  595. '              PRINT USING statement).
  596. '          (4) Now you need to use a utility PWW.EXE. Compile PWW.BAS to create
  597. '              it if you need to. Type PWW, followed optionally by the name
  598. '              of your POPWINDOW file (with or without its .PW extension). If
  599. '              you haven't screwed up, an INClude file will be created just
  600. '              like PWDEMO.INC, to include (or read into) your program !!
  601. '===============================================================================
  602.  
  603.  RESTORE OpenEntryWindow
  604.  
  605.                           $INCLUDE "CkWindow.inc" '      contains DATA statements
  606. '                                                      to define the window.
  607.    CALL POPWINDOW
  608.  
  609.  If SoundOn THEN PLAY LookItBeep$
  610.  
  611. '===============================================================================
  612. '   OK, now what's happened ?? First off, your data entry window has been
  613. '   opened (drawn) on the screen, using the attribute BoxColor; and the blank
  614. '   data fields have been added using FieldColor. Also a table has been created
  615. '   in memory consisting of several arrays to instantly reset the cursor to
  616. '   any of the fields in the window and find which mask string to use on that
  617. '   particular field. This job is done by PWSetUp (). Read on ...
  618. '===============================================================================
  619.  
  620. '                    ____________________________
  621.  
  622.  NewRec = %True
  623.  
  624. BeginEntry:
  625.  
  626. GetTypeOfTransaction:
  627.  
  628.  COLOR ScrColor MOD 16, ScrColor \ 16
  629.  LOCATE 25,1: CALL ClearLine
  630.  LOCATE 24,1: CALL ClearLine: PRINT Esc2Q$; F1Help$;
  631.  COLOR FldColor MOD 16, FldColor \ 16
  632.  
  633.  
  634. '                                     create a SUPERMENU of these choices ...
  635.  MenuData$ (1) = "C CHECK"
  636.  MenuData$ (2) = "D DEPOSIT"
  637.  MenuData$ (3) = "A AUTO DEBIT"
  638.  MenuData$ (4) = "T TRANSFER"
  639.  MenuData$ (5) = "J ADJUSTMENT"
  640.  MenuData$ (6) = "END"
  641.  
  642.  CALL SCREENPUSH
  643.  
  644.  Choice = 1                 ' start with first item highlighted ...
  645.  Title$ = ""                 ' no title ...
  646.  Choice = 1
  647.  UseRArrow = %Yes
  648.  PullDown = %Yes
  649.  MenuDown = 2
  650.  MenuRight = -40
  651.  CALL SUPERMENU (MenuData$(), MenuRight, MenuDown, Choice, Title$, KeyPressed)
  652.  
  653.  IF KeyPressed = %RArrow THEN GOSUB MZap: GOTO FileSubMenu
  654.  IF KeyPressed = %F1 THEN GOSUB MenuHelpScrn: GOTO  BeginEntry
  655.  
  656.  IF Choice = 0 THEN
  657.    COLOR %Vlt, %Vlt: CLS
  658.    GOTO MainMenu
  659.  END IF
  660.  
  661. TypeOfTransferMenu:
  662.  
  663.  IF Choice = 4 THEN
  664.    DATA FROM CHECKING TO SAVINGS,
  665.    DATA FROM SAVINGS TO CHECKING,
  666.    DATA END
  667.                                           ' this is a POPMENU, the predecessor
  668.                                           ' of SUPERMENU. Now SUB POPMENU ()
  669.                                           ' is just a wrapper for SUPERMENU
  670.    RESTORE TypeOfTransferMenu             ' so I don't have to convert all my
  671.    MLine$ = "type of transfer"            ' old code. It uses READ intead of
  672.    Choice = 1                             ' passing an array.
  673.  
  674.      CALL POPMENU ("1", -12, 9, Choice, MLine$, Dum$)
  675.  
  676.    CALL SCREENPOP
  677.    IF Choice = 0 THEN GOTO BeginEntry
  678.    IF ColorDisplay THEN COLOR %Ylo,%Red
  679.    IF Choice = 1 THEN TransactionType$ = "TRANSFER C-S" ELSE_
  680.                                  TransactionType$ = "TRANSFER S-C"
  681.  ELSE
  682.    CALL SCREENPOP
  683.    TransactionType$ = MID$ (MenuData$ (Choice), 3)
  684.  END IF
  685.  
  686. '===============================================================================
  687. '  OK, gentle hackfriend -- don't panic! What happens in the first data entry
  688. '  field in this dummy checkbook program, is that two successive menus are used
  689. '  as "pick lists" to get the data rather than having the user type it in. (If
  690. '  this isn't clear, try it out -- run HBDEMO.EXE -- and it should make
  691. '  a modicum of sense.)
  692. '
  693. '  So here is that PWSetUp () call. It searches out a field name in the table
  694. '  I mentioned above to match the field description string (FldN$)
  695. '===============================================================================
  696.  
  697.  FldN$ = "TYPE OF TRANSACTION"
  698.  COLOR FldColor MOD 16, FldColor \ 16
  699.  KeyField = %False
  700.  
  701.  CALL PWSetUp (FldN$,Tbl%)
  702. '                                             now the cursor should be in
  703. '                                             the right place and Tbl%
  704. '                                             should be the right item # in
  705. '                                             the array. Let's try it & see ...
  706.  
  707.  PRINT USING FieldMask$(Tbl%); TransactionType$
  708. '                _______________________________________      WOW !!! NeatO !!
  709.  
  710. CheckNumberEntry:
  711.  
  712.  COLOR %Blk, %Blk: LOCATE 23,1: CALL ClearLine
  713.  COLOR ScrColor MOD 16, ScrColor \ 16
  714.  LOCATE 25,1: CALL ClearLine: PRINT "    "; F2Fun$; Up2B$; Esc2Q$;
  715.  LOCATE 24,1: CALL ClearLine: PRINT EnHelp$;
  716.  COLOR FldColor MOD 16, FldColor \ 16
  717.  
  718.  FldN$ = "NUMBER": A# = Item%
  719.  CALL PWSetUp (FldN$,Tbl%)
  720.  
  721.  IF RTRIM$ (TransactionType$) = "CHECK" THEN
  722.    KeyField = %True '                    this clues in the FileFunctions menu
  723.    Msg$ = "F1 F2 UpOut"
  724. '                                                  ENTERNUMBER () works a lot
  725.      CALL ENTERNUMBER (A#,"####",Msg$) '           like ENTERSTRING () except
  726. '                                                  you specify a Mask String
  727. '                                                  so it can do PRINT USING.
  728.  
  729.    IF Msg$ = "HELP!" THEN GOSUB EDHelp: GOTO CheckNumberEntry
  730.    IF Msg$ = "Up" OR Msg$ = "ShfTab" GOTO GetTypeOfTransaction
  731.    Item% = A#
  732.    GOSUB F2orEscHandler
  733.  ELSE
  734.    PRINT " -- "
  735.  END IF
  736.  
  737. DateEntry:
  738.  
  739.  LOCATE 25,1: CALL ClearLine: PRINT "    "; Up2B$; Esc2Q$;
  740.  BXScreenSaved = %False
  741.  KeyField = %True
  742.  FldN$ = "DATE"
  743.  CALL PWSetUp (FldN$,Tbl%)
  744.  L = CSRLIN: C = POS
  745.  IF DateLastUsed$ = "" OR_
  746.                     FigDate& (DateLastUsed$) = 0 THEN DateLastUsed$ = GetDate$
  747.  
  748.  IF Msg$ <> "Up" AND Msg$ <> "ShfTab" OR_
  749.          FigDate& (TransactionDate$) = 0 THEN TransactionDate$ = DateLastUsed$
  750.  
  751.  Msg$ = "N/AOK"
  752.  
  753.    CALL RotaDate (TransactionDate$,Msg$)
  754.  
  755. ' =========================================================================
  756. '     ROTADATE: This is the date entry routine where you can use the cursor
  757. '        keys to go ahead or back to the date you want. If you want you can
  758. '        also key in the date in the usual way ...
  759. ' =========================================================================
  760.  
  761.    IF Msg$ = "HELP!" THEN GOSUB EDHelp: GOTO DateEntry
  762. '                                                     FigDate returns a 0 if
  763. ' LOCATE L,C
  764. ' PRINT TransactionDate$
  765.  IF Msg$ = "Up" OR Msg$ = "ShfTab" GOTO CheckNumberEntry
  766.  GOSUB F2orEscHandler
  767.  DateLastUsed$ = TransactionDate$
  768.  
  769. ToFromWhomEntry:
  770.  COLOR ScrColor MOD 16, ScrColor \ 16
  771.  LOCATE 24,1: CALL ClearLine: PRINT EnHelp$;
  772.  LOCATE 25,1: CALL ClearLine: PRINT "    "; F2Fun$; Up2B$; Esc2Q$;
  773.  COLOR FldColor MOD 16, FldColor \ 16
  774.  KeyField = %True
  775.  FldN$ = "TO/FROM"
  776.  CALL PWSetUp (FldN$,Tbl%)
  777.  X = CSRLIN: Y = POS
  778.  Msg$ = "F1F2UpOutCaps"
  779.  
  780.  IF RTRIM$ (TransactionType$) = "AUTO DEBIT" THEN
  781.    ToFrom$ = "CASH FROM A.T.M."
  782.  ELSE
  783.    ToFrom$ = ""
  784.  END IF
  785.  
  786.    CALL ENTERSTRING (ToFrom$,LEN(FieldMask$(Tbl%)),Msg$)
  787.  
  788.  IF Msg$ = "HELP!" THEN GOSUB EDHelp: GOTO ToFromWhomEntry
  789.  IF Msg$ = "Up" OR Msg$ = "ShfTab" THEN GOTO DateEntry
  790.  GOSUB F2orEscHandler
  791.  KeyField = %False
  792.  IF Msg$ = "Up" THEN
  793.    GOTO DateEntry
  794.  ELSE
  795.    ToFrom$ = A$
  796.  END IF
  797.  
  798. EntAmt:
  799.  COLOR Ink2, Paper2
  800.  COLOR FldColor MOD 16, FldColor \ 16
  801.  LOCATE 25,1: CALL ClearLine: PRINT Up2B$; Esc2Q$;
  802.  FldN$ = "AMOUNT": Amt# = 0
  803.  CALL PWSetUp (FldN$,Tbl%)
  804.  Msg$ = "F2UpOut - "
  805.  
  806.    CALL ENTERNUMBER (Amt#, FieldMask$(Tbl%), Msg$)
  807.  
  808.  IAmtCents& = 100 * Amt#
  809.  IF Msg$ = "Up" OR Msg$ = "ShfTab" GOTO ToFromWhomEntry
  810.  IF Msg$ = "HELP!" THEN GOSUB EDHelp: GOTO EntAmt
  811.  GOSUB F2orEscHandler
  812.  
  813. SaveRecord:
  814.  
  815.  COLOR %Wht,%Blk: LOCATE 24,1: CALL ClearLine: LOCATE 25,1: CALL ClearLine
  816.  LOCATE 24,9: PRINT "Note: THERE IS NO REAL SAVE RECORD FUNCTION -- DUMMY ONLY";
  817.  CALL SCREENPUSH
  818.  CALL QBox (19,30,1,"SAVE RECORD ?? ",3)
  819.  If SoundOn THEN PLAY LookitBeep$
  820.  CALL ENTERYESNO (Confirm) '                      query if save to be done ...
  821.  CALL SCREENPOP
  822.  IF Confirm THEN
  823.    If SoundOn THEN PLAY TaskBeep$
  824.    DELAY 1.6
  825.    IF RTRIM$ (TransactionType$) = "CHECK" THEN INCR Item%
  826.    GOTO MainMenu
  827.  ELSE
  828.    GOTO BeginEntry
  829.  END IF
  830.  
  831.  GOSUB SaveRecord
  832.  
  833.  GOTO OpenEntryWindow
  834. '___________________________________________________________________________
  835.  
  836.  
  837. F2orEscHandler:
  838. '                          Smart menu of choices appropriate to a database,
  839. '                                  such as SAVE, CLEAR, FIND, NEXT etc.
  840.  IF Msg$ = "F2" THEN
  841.   If SoundOn THEN PLAY LookitBeep$
  842.  
  843.   SELECT CASE GetFileFunction$
  844.     CASE "C"
  845.       RETURN OpenEntryWindow
  846.     CASE "F"
  847.       RETURN FakeFunction
  848.     CASE "S"
  849.       RETURN SaveRecord
  850.     CASE ELSE
  851.       RETURN
  852.    END SELECT
  853.  
  854.  ELSEIF Msg$ = "ESC" THEN
  855.     IF LTRIM$ (TransactionType$) <> "" THEN
  856.       CALL SCREENPUSH
  857.       CALL QBox (%Center, %Center, 1,_
  858.             "DO YOU WANT TO CLEAR THIS ENTRY AND RETURN TO MAIN MENU ?? ", 7)
  859.       IF NOT GetYesOrNo THEN CALL SCREENPOP: RETURN
  860.     END IF
  861.     NextScrn2Pop = MainMenuScreen
  862.     CALL SCREENPOP
  863.     RETURN MainMenu
  864.  END IF
  865.  RETURN
  866.  
  867. '    ___________________________________________________________________
  868.  
  869. EnterDemo:
  870.  
  871.  If SoundOn THEN PLAY LookitBeep$
  872.  IF ColorDisplay THEN
  873.    FldColor =  %Ylo + %Background * %Red
  874.    ScrColor =  %Ylo + %Background * %Blk
  875.  END IF
  876.  COLOR %Gry, %Blk
  877.  CLS
  878. '   Code to write Static Window {ENTERDEM} to Screen
  879. '        note: created by StatWindow Writer (SWW) from ENTERDEM.SW
  880.  
  881.  COLOR BoxColor MOD 16, BoxColor \ 16
  882.  LOCATE  2, 9
  883.  PRINT "┌───────────────────────────────────────────────────────────┐"
  884.  LOCATE  3, 9
  885.  PRINT "│        A-P Library Demo : the Data Entry Routines         │";
  886.  LOCATE  4, 9
  887.  PRINT "│                                                           │";
  888.  LOCATE  5, 9
  889.  PRINT "│         (ENTERSTRING, ENTERNUM, ENTERDATE ETC.)           │";
  890.  LOCATE  6, 9
  891.  PRINT "└───────────────────────────────────────────────────────────┘";
  892.  
  893.  COLOR ScrColor MOD 16, ScrColor \ 16
  894.  
  895. '  07-06-1990, 23:46:   end of StatWindow generated code for window {ENTERDEM}
  896.  
  897.  LOCATE 24,1: CALL ClearLine: PRINT EnHelp$;
  898.  LOCATE 25,1: CALL ClearLine: PRINT F1Help$;
  899.  
  900. '    -----------------------   First line: a plain entry, except no lower case:
  901. StartEntries:
  902.  COLOR ScrColor MOD 16, ScrColor \ 16
  903.  O$ = "DEFAULT ENTRY" '                          the string starts off as this
  904.  LOCATE 7,4: PRINT "REGULAR ENTRY, ALL CAPS w/ DEFAULT: "; ' leave cursor here
  905.  COLOR FldColor MOD 16, FldColor \ 16
  906.  Msg$ = "Caps F1" '                                use all capitals, accept F1
  907.  FLength = 14
  908.  
  909.    CALL ENTERSTRING (O$, FLength, Msg$)
  910.  
  911.  COLOR ScrColor MOD 16, ScrColor \ 16
  912.  LOCATE 7,60: PRINT "Msg$ = ";Msg$;"   " '                    The value of Msg$
  913.  IF Msg$ = "HELP!" THEN GOSUB EDHelp: GOTO StartEntries '     on termination of
  914.  IF Msg$ = "ESC" GOTO DoneED '                                SUB ENTER* shows
  915. '                                                             what key was used
  916. '                                                             to exit the sub.
  917.  
  918. ' --------------------------  Next line: a string with Auto-CR when field full:
  919.  
  920.  P$ = "Just keep typing ..."
  921. AutoE:
  922.  COLOR ScrColor MOD 16, ScrColor \ 16
  923.  LOCATE 9,4: PRINT "ENTRY w/ AUTOMATIC TERMINATION: ";
  924.  COLOR FldColor MOD 16, FldColor \ 16
  925.  Msg$ = "F1 Auto"
  926.  
  927.    CALL ENTERSTRING (P$, 20, Msg$)
  928.  
  929.  COLOR ScrColor MOD 16, ScrColor \ 16
  930.  LOCATE 9,60: PRINT "Msg$ = ";Msg$;"   "
  931.  IF Msg$ = "HELP!" THEN GOSUB EDHelp: GOTO AutoE
  932.  IF Msg$ = "ESC" GOTO DoneED
  933.  
  934. ' ------------------------  This time up-arrow, ShfTab or left arrow will exit
  935.  
  936.  LOCATE 25,1: PRINT Up2B$; F1Help$;
  937. UpArrE:
  938.  COLOR ScrColor MOD 16, ScrColor \ 16
  939.  LOCATE 11,4: PRINT "ENTRY w/ UP-ARROW & BACK-OUT ENABLED: ";
  940.  COLOR FldColor MOD 16, FldColor \ 16
  941.  Msg$ = "F1UpOut BackOut"
  942.  
  943.    CALL ENTERSTRING (Q$, 4, Msg$)
  944.  
  945.  COLOR ScrColor MOD 16, ScrColor \ 16
  946.  LOCATE 11,60: PRINT "Msg$ = ";Msg$;"   "
  947.  IF Msg$ = "HELP!" THEN GOSUB EDHelp: GOTO UpArrE
  948.  IF Msg$ = "Up" OR Msg$ = "Left" OR Msg$ = "ShfTab" GOTO AutoE
  949.  IF Msg$ = "ESC" GOTO DoneED
  950.  
  951. ' ----------------------------- Let us not forget the main purpose of
  952. '                               computers, counting beans! Here is money entry:
  953. DollE:
  954.  COLOR ScrColor MOD 16, ScrColor \ 16
  955.  LOCATE 13, 4: PRINT "DOLLAR AMOUNT ENTRY: ";
  956.  COLOR FldColor MOD 16, FldColor \ 16
  957.  IF Msg$ <> "Up" THEN O# = 0: Msg$ = "F1UpOut"
  958. '                                              Here is ENTERNUMBER ().
  959.    CALL ENTERNUMBER (O#,"$####.##", Msg$) '    Note that the second argument is
  960. '                                              a mask string for PRINT USING.
  961.  COLOR ScrColor MOD 16, ScrColor \ 16
  962.  LOCATE 13,60: PRINT "Msg$ = ";Msg$;"   "
  963.  IF Msg$ = "HELP!" THEN GOSUB EDHelp: GOTO DollE
  964.  IF Msg$ = "Up" OR Msg$ = "ShfTab" GOTO UpArrE
  965.  IF Msg$ = "ESC" GOTO DoneED
  966.  
  967. ' ---------------------------- Now let's enter a decimal number.
  968. NumE:
  969.  COLOR ScrColor MOD 16, ScrColor \ 16
  970.  LOCATE 15, 4: PRINT "NUMERIC ENTRY, 1 DECIMAL: ";
  971.  COLOR FldColor MOD 16, FldColor \ 16
  972.  Msg$ = "F1UpOut"
  973.  IF Msg$ <> "Up" THEN P# = 98.6
  974.  
  975.    CALL ENTERNUMBER (P#,"##.#", Msg$)
  976.  
  977.  COLOR ScrColor MOD 16, ScrColor \ 16
  978.  LOCATE 15,60: PRINT "Msg$ = ";Msg$;"   "
  979.  IF Msg$ = "HELP!" THEN GOSUB EDHelp: GOTO NumE
  980.  IF Msg$ = "Up" OR Msg$ = "ShfTab" GOTO DollE
  981.  IF Msg$ = "ESC" GOTO DoneED
  982.  
  983. ' ---------------------------------  ... an SSA # ...
  984. SSNE:
  985.  COLOR ScrColor MOD 16, ScrColor \ 16
  986.  LOCATE 17,4: PRINT "ENTER A SOCIAL SECURITY #: ";
  987.  COLOR FldColor MOD 16, FldColor \ 16
  988. '         IF Msg$ <> "Up" THEN SSN$ = ""
  989.  Msg$ = "F1UpOut"
  990.  
  991.    CALL ENTERSSN (SSN$, Msg$)
  992.  
  993.  COLOR ScrColor MOD 16, ScrColor \ 16
  994.  LOCATE 17,60: PRINT "Msg$ = ";Msg$;"   "
  995.  IF Msg$ = "HELP!" THEN GOSUB EDHelp: GOTO SSNE
  996.  IF Msg$ = "Up" OR Msg$ = "ShfTab" GOTO NumE
  997.  IF Msg$ = "ESC" GOTO DoneED
  998.  
  999. ' ------------------------------------
  1000. PhoneE:
  1001.  COLOR ScrColor MOD 16, ScrColor \ 16
  1002.  LOCATE 19,4: PRINT "ENTER A PHONE #: ";
  1003.  COLOR FldColor MOD 16, FldColor \ 16
  1004.  IF Msg$ <> "Up" THEN Phone$ = ""
  1005.  Msg$ = "F1UpOut"
  1006.  
  1007.    CALL ENTERPHONE (Phone$, Msg$)
  1008.  
  1009.  COLOR ScrColor MOD 16, ScrColor \ 16
  1010.  LOCATE 19,60: PRINT "Msg$ = ";Msg$;"   "
  1011.  IF Msg$ = "HELP!" THEN GOSUB EDHelp: GOTO PhoneE
  1012.  IF Msg$ = "Up" OR Msg$ = "ShfTab" GOTO SSNE
  1013.  IF Msg$ = "ESC" GOTO DoneED
  1014.  
  1015. '            =========== NEW !!! ====================
  1016.   CALL SCREENPUSH
  1017.   CALL QBox (%Center, %Center, 3,_
  1018.                "Here's the NEW phone # routine, FASTPHONE", 14)
  1019.   CALL FASTPHONE (Phone2$, Msg$)
  1020.   CALL PressAKey
  1021.   CALL SCREENPOP
  1022.  
  1023. ' ------------------------------------------------------- a date & a time ...
  1024.  
  1025.  IF DateLastUsed$ = "" OR_
  1026.                     FigDate& (DateLastUsed$) = 0 THEN DateLastUsed$ = GetDate$
  1027.  
  1028.  IF Msg$ <> "Up" AND Msg$ <> "ShfTab" OR_
  1029.                                    FigDate& (D0$) = 0 THEN D0$ = DateLastUsed$
  1030.  
  1031.  COLOR ScrColor MOD 16, ScrColor \ 16
  1032.  LOCATE 21,4: PRINT "DATE (use arrows or numbers) ";
  1033.  COLOR FldColor MOD 16, FldColor \ 16
  1034.  Msg$ = "F1 N/Aok"
  1035.  
  1036.    CALL ROTADATE (D0$, Msg$)
  1037.  
  1038.  IF Msg$ = "Up" OR Msg$ = "ShfTab" GOTO PhoneE
  1039.  IF Msg$ = "ESC" GOTO DoneED
  1040.  
  1041.  COLOR ScrColor MOD 16, ScrColor \ 16
  1042.  LOCATE 21,50: PRINT "TIME: ";
  1043.  COLOR FldColor MOD 16, FldColor \ 16
  1044.  T$ = ""
  1045.  Msg$ = "F1UpOut"
  1046.  
  1047.    CALL ENTERTIME (T$, Msg$)
  1048.  
  1049.  IF Msg$ = "Up" OR Msg$ = "ShfTab" GOTO PhoneE
  1050.  
  1051. DoneED:
  1052.  LOCATE 25,1: CALL ClearLine
  1053.  IF NeedDCon THEN
  1054.    PRINT "          hit a key or click your beast to go on ...";
  1055.  ELSE
  1056.    PRINT "          hit a key to go on ...";
  1057.  END IF
  1058.  COLOR ScrColor MOD 16, ScrColor \ 16
  1059.  LOCATE 24,1: CALL ClearLine
  1060.  GOSUB ClickOrStrike
  1061.  GOTO MainMenu
  1062.  
  1063. EDHelp:
  1064.  CALL SCREENPUSH
  1065.  RESTORE EDHelp
  1066.  CALL BOXMESSAGE (0, 0, 1)
  1067.  GOSUB ClickOrStrike
  1068.  CALL SCREENPOP
  1069.  COLOR FldColor MOD 16, FldColor \ 16
  1070.  RETURN
  1071.  
  1072.  DATA "HELP FOR DATA ENTRY ROUTINES FROM HB'S ALL-PURPOSE POWER-BASIC TOOLBOX"
  1073.  DATA ""
  1074.  DATA "There is a space on the screen to type something into. The keyboard"
  1075.  DATA "works the way you'd expect it to -- just like typing on a word"
  1076.  DATA "processing program. If numbers are expected, no other keys will work."
  1077.  DATA ""
  1078.  DATA "Use [INSERT] key to switch between Insert Mode (Big Cursor) and  "
  1079.  DATA "Overstrike Mode. The [BACKSPACE] key works, & the [DELETE] key removes"
  1080.  DATA "the letter the cursor is on. Press [ESC] to quit the entry process."
  1081.  DATA ""
  1082.  DATA "If there is something in the field to begin with and you start"
  1083.  DATA "typing something else, the field clears. If you move the cursor"
  1084.  DATA "around first, that doesn't happen. Use Ctrl-U to undo."
  1085.  DATA ""
  1086.  DATA " Use:   [HOME] key, [END] key, Arrow Keys (Rt & Left) to move cursor   "
  1087.  DATA "        Ctrl-Y to clear the line                                       "
  1088.  DATA "        Ctrl-T to delete one word (to right)                           "
  1089.  DATA "        Ctrl-U to undo (restore original string)                       "
  1090.  DATA "        Ctrl-Rt or Left Arrow, (jumps to beginning of a word)          "
  1091.  DATA ""
  1092.  DATA "See bottom line of screen for more help.                PRESS ANY KEY  "
  1093.  DATA END
  1094.  
  1095. ' ===========================================================================
  1096.  
  1097. DateTest:
  1098.  If SoundOn THEN PLAY LookitBeep$
  1099.  IF ColorDisplay THEN
  1100.    Ink1 = %Blu: Paper1 = %Cyn: Ink2 = %Wht: Paper2 = %Red
  1101.  ELSE
  1102.    Ink1 = %Wht: Paper1 = %Blk: Ink2 = %Blk: Paper2 = %Gry
  1103.  END IF
  1104.  COLOR Ink1, Paper1: CLS
  1105.  ON KEY (15) GOSUB Done
  1106.  
  1107.  DO
  1108.    DoB$ = ""
  1109.    COLOR Ink1, Paper1
  1110.    LOCATE 5,6: PRINT "Date of Birth :";
  1111.    COLOR Ink2, Paper2
  1112.    Msg$ = ""
  1113.    CALL ENTERDATE (DoB$, Msg$)
  1114.  LOOP UNTIL DoB$ <> "" '                          if date entered not valid,
  1115. '                                                 the result string will be ""
  1116.       COLOR Ink1, Paper1
  1117.       LOCATE 7,6
  1118.       W& = FigDate&(DoB$)
  1119.       IF W& = 0 THEN RETURN MainMenu
  1120.       PRINT "Days from 1-1-1900 (Julioid) = ";
  1121.       COLOR Ink2, Paper2: PRINT W&
  1122.  
  1123.       LOCATE 9,6: COLOR Ink1, Paper1
  1124.       PRINT "Converting Back to Date = ";
  1125.       COLOR Ink2, Paper2: PRINT WriteDate$(W&)
  1126.       LOCATE 10,6
  1127.       COLOR Ink1, Paper1: PRINT "  (This Date was a ";
  1128.       COLOR Ink2, Paper2: PRINT WkDay$(W&);
  1129.       COLOR Ink1, Paper1: PRINT " )."
  1130.  
  1131.       Today$ = GetDate$ '                                      a function ...
  1132.       LOCATE 12,6: COLOR Ink1, Paper1: PRINT "Today is ";
  1133.       COLOR Ink2, Paper2
  1134.       PRINT Today$
  1135.       LOCATE 14,6: COLOR Ink1, Paper1: PRINT "YOUR AGE IS: ";
  1136.       COLOR Ink2, Paper2
  1137.       PRINT YearsSince (DoB$)
  1138.       BDay$ = DoB$: MID$ (Bday$,7) = RIGHT$ (Today$,2)
  1139.  
  1140.       N = FigDate& (BDay$) - FigDate& (Today$)
  1141.       LOCATE 16,6: COLOR Ink1, Paper1
  1142.       SELECT CASE N
  1143.          CASE 0
  1144.            L = CSRLIN: C = POS
  1145.            COLOR Ink1+16, Paper1
  1146.            PRINT "HAPPY BIRTHDAY !!"
  1147.            LOCATE ,,0
  1148.            PLAY "O2 G8 G16 A4 G4 O3 C4 O2 B2": DELAY 2
  1149.            COLOR Ink1, Paper1: LOCATE L,C,1
  1150.            PRINT "HAPPY BIRTHDAY !!"
  1151.          CASE > 0
  1152.            PRINT "Your BIRTHDAY is only ";N;" days from today !"
  1153.            If SoundOn THEN PLAY TaskBeep$
  1154.          CASE < 0
  1155.            PRINT "Your BIRTHDAY was ";ABS(N);" days ago."
  1156.            If SoundOn THEN PLAY TaskBeep$
  1157.       END SELECT
  1158.  
  1159.  LOCATE 25,1: CALL ClearLine
  1160.  CALL PressAKey
  1161.  GOSUB Done
  1162.  
  1163. Done:
  1164.  RETURN MainMenu
  1165.  
  1166. '__________________________________________________________________________
  1167.  
  1168. Logo2:
  1169.   DATA HB's ALL-PURPOSE LIBRARY DEMO, For POWER BASIC, SPRING 1991, END
  1170.   RESTORE Logo2
  1171.   CALL BOXMESSAGE (0,0,1)
  1172.     RETURN
  1173.  
  1174. Logo3:
  1175.   RESTORE Logo2
  1176.   CALL BOXMESSAGE (1,1,1)
  1177.     RETURN
  1178.  
  1179. '__________________________________________________________________________
  1180.  
  1181.  
  1182. SUB CloseFiles PUBLIC
  1183.  
  1184. '      What normally has to be done here, in a database program, is the
  1185. '      index file closures (writing back data). If the program just crashes
  1186. '      out to DOS, thus automatically closing all files at the DOS level,
  1187. '      the index files will have been corrupted.
  1188.  
  1189.    Dummy = IsRodent '                    also reset your furry friend if any ...
  1190.  
  1191.  END SUB
  1192.  
  1193.  
  1194. ' ______________________________________________________________________
  1195.  
  1196.  
  1197. HarmlessError:
  1198.  
  1199.    L00 = CSRLIN: C00 = POS
  1200.    CALL SCREENPUSH
  1201.    FlaskBox = %True
  1202.    CALL QBox (%Center, %Center, 1, "ERROR " + STR$(ERR) + " @ " +_
  1203.                                                   STR$(ERADR), 0)
  1204.    CALL PressAKey
  1205.    CALL SCREENPOP
  1206.    LOCATE L00, C00
  1207.    RESUME NEXT
  1208.  
  1209.  
  1210. FakeFunction:
  1211.  COLOR %LCyn, %Blu
  1212.  If SoundOn THEN PLAY LookitBeep$
  1213.  CLS
  1214.  LOCATE 10,10,0:PRINT "This function will of course be brilliantly implemented"
  1215.  DELAY .5
  1216.  LOCATE 12, 11: PRINT "by you, the creator of your own magnificent applications
  1217.  DELAY .5
  1218.  LOCATE 14, 13: PRINT "using Power Basic and this humble Library."
  1219.  If SoundOn THEN PLAY ArribaBeep$
  1220.  CALL PressAKey
  1221.  GOTO MainMenu
  1222.  
  1223. '____________________________________________________________________________
  1224.  
  1225. ' ======================================================================
  1226.                                  $SEGMENT
  1227. ' ======================================================================
  1228.  
  1229. Directory:
  1230. '                                          this worked under PB 2.0; it doesn't
  1231.  DIM DYNAMIC ListOfDirectories$ (32) '     use the DIR$ function introduced in
  1232.  CALL QBox (5,36,1,"FileSpec ?? ", 20) '   version 2.1. Instead it uses DirFirst
  1233.  COLOR FldColor MOD 16, FldColor \ 16 '    and DirNext from MISC-U.PBU, which
  1234.  M$ = "*.*" '                              can also return file size, date etc.
  1235.  Msg$ = "Cap"
  1236.  CALL ENTERSTRING (M$, 20, Msg$)
  1237.  IF Msg$ = "ESC" THEN ERASE ListOfDirectories$: RETURN
  1238.  
  1239.  U$ = "File \            \ saved \      \ at \       \  --  "
  1240.  M$ = FQFileSpec$ (M$)
  1241.  Heading$ = "HB Custom Directory of " + M$
  1242.  Heading$ = LEFT$ (Heading$, 80)
  1243.  
  1244.  COLOR %Cyn, %Blk: CLS: LOCATE 1, 41-LEN(Heading$)\2: PRINT Heading$
  1245.  
  1246.  Fls% = 0
  1247.  FlName$ = M$
  1248.  CALL DirFirst (FlName$, FileSize&, DateCode&, TimeCode&)
  1249.  IF FlName$= "" THEN
  1250.    CALL QBox (11, 30, 1, "No file "+ M$ +" found", 0)
  1251.    CALL PressAKey
  1252.    ERASE ListOfDirectories$
  1253.    RETURN
  1254.  ELSE
  1255.    INCR Fls%
  1256.    GOSUB PrDir
  1257.    DO
  1258.      CALL DirNext (FlName$, FileSize&, DateCode&, TimeCode&)
  1259.      IF FlName$ = "" THEN EXIT LOOP
  1260.      GOSUB PrDir
  1261.      INCR Fls%
  1262.      IF CSRLIN > 23 THEN
  1263.        COLOR %Cyn, %Blk
  1264.        IF NeedDCon THEN
  1265.          PRINT "                   ... PRESS ANY KEY (OR MOUSEBUTTON) TO GO ON";
  1266.        ELSE
  1267.          PRINT "                                   ... PRESS ANY KEY TO GO ON";
  1268.        END IF
  1269.        T& = TIMER
  1270.        DO: K$ = INKEY$: LOOP UNTIL K$ <> "" OR MouseClicked OR TIMER - T& > 4
  1271.        IF K$ = CHR$ (27) THEN GOTO DoneDirectory
  1272.        COLOR %Cyn, %Blk: CLS
  1273.        LOCATE 1, 41-LEN(Heading$)\2: PRINT Heading$
  1274.      END IF
  1275.    LOOP
  1276.    PRINT
  1277.    COLOR %Cyn, %Blk: PRINT Fls% ;"Files found"
  1278.  END IF
  1279.  
  1280.  IF RIGHT$ (M$, 3) = "*.*" THEN  '         only show subdirectories if a full
  1281.    PRINT '                                 directory was listed
  1282.    COLOR %Wht, %Blk
  1283.    PRINT STRING$ (80, 205);
  1284.    PRINT
  1285.    PRINT "Subdirectories of "; M$;
  1286.    N = 1: D% = 1
  1287.    DO WHILE (ListOfDirectories$ (N)) <> ""
  1288.      PRINT
  1289.      IF MID$ (ListOfDirectories$ (N), 2, 1) <> "." THEN
  1290.        PRINT USING " \           \  (directory)"; ListOfDirectories$ (N);
  1291.        INCR D%
  1292.      END IF
  1293.      INCR N
  1294.    LOOP UNTIL INKEY$ <> ""
  1295.    IF D% = 1 THEN PRINT "  None"
  1296.  END IF
  1297.  
  1298.  CALL PressAKey
  1299.  
  1300. DoneDirectory:
  1301.  ERASE ListOfDirectories$
  1302.  D% = 0
  1303.  RETURN
  1304.  
  1305. PrDir:
  1306.  IF ColorDisplay THEN
  1307.    COLOR 2 + (7 * (CSRLIN - 2*(CSRLIN\2))), 0
  1308.  ELSE
  1309.    COLOR (7 * (CSRLIN - 2*(CSRLIN\2))), 7 - (7 * (CSRLIN - 2*(CSRLIN\2)))
  1310.  END IF
  1311.  IF LEFT$ (FlName$, 1) = "<" THEN
  1312.    INCR D%
  1313.    ListOfDirectories$ (D%) =FlName$
  1314.  ELSE
  1315.    PRINT USING U$; FlName$, DecodeDate$ (DateCode&), DecodeTime$ (TimeCode&);
  1316.    IF FileSize& < 1024 THEN
  1317.      PRINT USING "   ####  bytes   "; FileSize&
  1318.    ELSE
  1319.      PRINT USING "###.#    KB      "; FileSize& / 1024
  1320.    END IF
  1321.  END IF
  1322.  RETURN
  1323.  
  1324.  
  1325. MoveAMenuII:
  1326.    S = NextScrn2Pop
  1327.    NextScrn2Pop = 1
  1328.    CALL SCREENPOP
  1329.    NextScrn2Pop = S
  1330.    DELAY 1
  1331.  
  1332.    RANDOMIZE TIMER
  1333.    FOR Word = 1 TO 50
  1334.      LOCATE INT (1+RND*25), INT (1+RND*61)
  1335.      COLOR INT (1+RND*15), 0: PRINT "Important Data";
  1336.      DELAY .05
  1337.    NEXT Word
  1338.  
  1339.    MenuColor =  %Blk + %Background * %Gry
  1340.    BarColor =  %Ylo + %Background * %Grn
  1341.  
  1342.  D = 3: R = -4
  1343.                   ' menu lines are set up (D,R,L & Q will be the HotKeys) ...
  1344.  MenuData$(1) = "U UP"
  1345.  MenuData$(2) = "D DOWN"
  1346.  MenuData$(3) = "R RIGHT"
  1347.  MenuData$(4) = "L LEFT"
  1348.  MenuData$(5) = "Q QUIT"
  1349.  MenuData$(6) = "END"
  1350.  
  1351.  Choice = 1
  1352.  
  1353.  
  1354.  DO
  1355.    Title$ = "MOVE ME"                                    ' title
  1356.    MenuRight = R
  1357.    MenuDown = D
  1358.    CALL SCREENPUSH
  1359.  
  1360.    CALL SUPERMENU (MenuData$ (), MenuRight, MenuDown, Choice, Title$, Ky%)
  1361.  
  1362.    CALL SCREENPOP
  1363.    If SoundOn THEN PLAY TinyBeep$
  1364.  
  1365.    SELECT CASE Choice
  1366.      CASE 1
  1367.       IF D > 0 THEN DECR D,2
  1368.      CASE 2
  1369.       IF D < 30 THEN IF D = 3 THEN INCR D,1 ELSE INCR D,2
  1370.      CASE 3
  1371.       IF R < 40 THEN INCR R,4
  1372.      CASE 4
  1373.       IF R > -40 THEN DECR R,4
  1374.    END SELECT
  1375.  
  1376.  IF ColorDisplay THEN
  1377.    COLOR 15,5
  1378.  ELSE
  1379.    COLOR 0,7
  1380.  END IF
  1381.  
  1382.  LOCATE 25,3,0
  1383.  PRINT "ARGUMENTS: Choice = ";Choice;"MenuDown = ";D;
  1384.  PRINT "   --   ";"MenuRight = ";R;
  1385.  
  1386.  IF Ky% = %F1 THEN GOSUB MenuHelpScrn
  1387.  
  1388.  IF Ky% = %F2 THEN LOCATE 23,1: COLOR 14,7: PRINT " F2 Pressed! "
  1389.  
  1390.  LOOP UNTIL Choice = 5 OR Ky% = %Esc
  1391.  GOSUB SetColors
  1392.  RETURN
  1393.  
  1394.  
  1395. HundredItemsMenu:
  1396.  CALL SCREENPUSH '                              a multipage menu ...
  1397.  RANDOMIZE TIMER
  1398.  StartScreen =  NextScrn2Pop
  1399.  REDIM T$ (1:100)
  1400.  MenuPages = 7
  1401.  DO
  1402.    IF ColorDisplay THEN
  1403.      COLOR 0, RND * 8: CLS
  1404.    ELSE
  1405.      LOCATE 1,1
  1406.      FOR L = 1 TO 25: PRINT STRING$ (80, 176);: NEXT
  1407.    END IF
  1408.    COLOR %Ylo, %Grn
  1409.    MenuPage = 1
  1410.    Choice = 1
  1411.    DATA "Hundred Items", "Menu", "====", Use PG-DN or just
  1412.    DATA drag bar down past, last line to see, "more choices"
  1413.    DATA END
  1414.    RESTORE HundredItemsMenu
  1415.    CALL BOXMESSAGE (2, 1, 1)
  1416.    FOR I = 1 TO 100
  1417.      T$ (I) = USING$ ("  This is menu item ### ", I)
  1418.    NEXT
  1419.  
  1420.    DO
  1421.      FOR I = 1 TO 16
  1422.        IF (MenuPage - 1) * 16 + I > 100 THEN
  1423.          MenuData$ (I) = "END"
  1424.        ELSE
  1425.          MenuData$ (I) = T$ ((MenuPage - 1) * 16 + I)
  1426.        END IF
  1427.      NEXT
  1428.  
  1429.      MenuData$ (17) = "END"
  1430.      MenuRight = 6 * MenuPage -20
  1431.      MenuDown = MenuPage - 1
  1432.      Title$ = "PgUp/Pg-Dn for more"
  1433.      IF MenuPage > 1 THEN UsePgUp = %Yes
  1434.      IF MenuPage < 7 THEN UsePgDn = %Yes
  1435.  
  1436.      CALL SUPERMENU (MenuData$ (), MenuRight, MenuDown, Choice, Title$, Ky%)
  1437.  
  1438.      SELECT CASE Ky%
  1439.        CASE %PgUp
  1440.          DECR MenuPage
  1441.          CALL SCREENPOP
  1442.          Choice = 16
  1443.        CASE %PgDn
  1444.          INCR MenuPage
  1445.          CALL SCREENPUSH
  1446.          Choice = 1
  1447.        CASE %F1
  1448.          GOSUB MenuHelpScrn
  1449.      END SELECT
  1450.    LOOP UNTIL Ky% = %Esc OR Ky% = %CR
  1451.    NextScrn2Pop = StartScreen
  1452.    CALL SCREENPOP
  1453.  LOOP UNTIL Ky% = %Esc
  1454.  ERASE T$
  1455.  RETURN MainMenu
  1456.  
  1457. '   -------------------------------------------------------------------
  1458.  
  1459.  
  1460. MenuHelpScrn:
  1461.  CALL SCREENPUSH
  1462.  
  1463.  RESTORE MenuHelpScrn
  1464.  
  1465.  DATA "WHAT DOES THIS MENU DO ??  --  Not much really. After all, this whole"
  1466.  DATA "program is nothing but a demo."
  1467.  DATA ""
  1468.  DATA "IN THAT CASE, HOW DO I USE A MENU LIKE THIS ??"
  1469.  
  1470.  DATA " I thought you'd never ask! Well, you can use ..."
  1471.  DATA "(1) THE ONE KEY METHOD: Just find which item on the menu you want."
  1472.  DATA "There will be a letter or number at the start of the"
  1473.  DATA "item. Just press it and that's all."
  1474.  DATA "(2) THE CURSOR KEY METHOD: Use the up or down cursor / arrow keys"
  1475.  DATA "to move the highlighted bar to your selection, then"
  1476.  DATA "press the ENTER key."
  1477.  DATA "(3) THE PLASTIC PEST METHOD: Your mouse can make the choice you want!"
  1478.  DATA "You don't see a mouse cursor but don't panic. Just drag the"
  1479.  DATA "highlighted bar to your choice; then click the left button"
  1480. '                   NOTE: Other mouse button modes are supported. See the
  1481. '                         lines in MENUS-U that refer to LBPresses =
  1482. '                         and LBReleases (presently line # 460).
  1483.  DATA ""
  1484.  DATA "TO CANCEL THE MENU (Not make a choice):"
  1485.  DATA "Press the Escape key, or the right mouse button. (You can even press"
  1486.  DATA "the right button while you hold the left one -- or right after you"
  1487.  DATA "let it go.)"
  1488.  DATA END
  1489.  
  1490.        CALL BOXMESSAGE (%Center, %Center, 0)
  1491.  
  1492.  GOSUB ClickOrStrike
  1493.  CALL SCREENPOP
  1494.  RETURN
  1495.  
  1496. ' -------------------------------------------------------------------------
  1497.  
  1498. BeepTest:
  1499.  LOCATE 22,1
  1500.  IF ColorDisplay THEN
  1501.    Ink1 = %Blu:  Paper1 = %Cyn: Ink2 = %LCyn: Paper2 = %Blu
  1502.  ELSE
  1503.    Ink1 = %Gry:  Paper1 = %Blk: Ink2 = %Blk:  Paper2 = %Gry
  1504.  END IF
  1505.  DELAY .7: If SoundOn THEN PLAY LookitBeep$
  1506.  DO
  1507.    IF CSRLIN > 20 THEN
  1508.      COLOR Ink1, Paper1: CLS
  1509.      COLOR Ink2, Paper2
  1510.      LOCATE 1,22: PRINT " HB BEEP-TESTING ENVIRONMENT, V. 1.0 "
  1511.      LOCATE 22,1: CALL ClearLine
  1512.      LOCATE 23,1: CALL ClearLine
  1513.      PRINT "    Use syntax for PLAY as in BASICA and ";
  1514.      PRINT "PowerBasic, e.g. O0 G2 A4 B-4 P4 G4"
  1515.      LOCATE 24,1: CALL ClearLine
  1516.      COLOR Ink1, Paper1
  1517.      LOCATE 3,1
  1518.    END IF
  1519.    PRINT " PLAY ";CHR$(34);SPACE$(45);CHR$(34);
  1520.    LOCATE CSRLIN, 8
  1521.    Msg$ = "Auto Caps"
  1522.    CALL ENTERSTRING (A$, 45, Msg$)
  1523.    IF Msg$ = "ESC" OR A$ = "" THEN
  1524.       PRINT "                                   QUIT ?? ";
  1525.       Quit = GetYesOrNo
  1526.       IF Quit THEN
  1527.         EXIT LOOP
  1528.       ELSE
  1529.         GOTO There
  1530.       END IF
  1531.    ELSE
  1532.      ON ERROR GOTO Clunker
  1533.      IF A$ <> "" THEN PLAY A$
  1534.      ON ERROR GOTO Oops
  1535.      LOCATE (CSRLIN), 56
  1536.      PRINT "Print It ?";
  1537.      Yes = GetYesOrNo
  1538.      IF Yes THEN
  1539.         INPUT "                         Comment ? ",B$
  1540.         L = CSRLIN
  1541.         COLOR 16+Ink2, Paper2
  1542.         LOCATE 25,3,0: CALL ClearLine: PRINT "PRINTING ...";
  1543.         LPRINT "From HB PowerBasic Beep Tester, ";GetDate$;":"
  1544.         LPRINT "    Name: ";B$;" -- PLAY ";CHR$(34);A$;CHR$(34)
  1545.         LOCATE 25,1,1: CALL ClearLine
  1546.         COLOR Ink1, Paper1
  1547.         LOCATE L+1, 1
  1548.      ELSE
  1549.         PRINT
  1550.      END IF
  1551.    END IF
  1552. There:
  1553.  LOOP
  1554.  RETURN
  1555.  
  1556. Clunker:
  1557.  PLAY "O1 C2"
  1558.  A$ = ""
  1559.  RESUME NEXT
  1560.  
  1561. MessageBoxTest:
  1562.  COLOR ScrColor MOD 16, ScrColor \ 16
  1563.  CLS
  1564.  CALL QBox (3, %Center, 1, "DEMO OF MESSAGE WINDOWS (TRY TO MAKE IT FAIL!)", 0)
  1565.  
  1566.  COLOR ScrColor MOD 16, ScrColor \ 16
  1567.  LOCATE 10, 50: PRINT "... 0 = Horiz. Centered Box"
  1568.  LOCATE 10,5: PRINT "LEFT UPPER CORNER AT COLUMN ";
  1569.  COLOR FldColor MOD 16, FldColor \ 16
  1570.  CALL ENTERNUMBER (CCol#, "###", Msg$)
  1571.  IF Msg$ <> "CR" THEN RETURN MainMenu
  1572.  
  1573.  COLOR ScrColor MOD 16, ScrColor \ 16
  1574.  LOCATE 12, 50: PRINT "... 0 = Vert. Centered Box"
  1575.  LOCATE 12,5: PRINT "LEFT UPPER CORNER AT ROW ";
  1576.  COLOR FldColor MOD 16, FldColor \ 16
  1577.  CALL ENTERNUMBER (CLin#, "###", Msg$)
  1578.  IF Msg$ <> "CR" THEN RETURN MainMenu
  1579.  
  1580.  COLOR ScrColor MOD 16, ScrColor \ 16
  1581.  LOCATE 14,5: PRINT " MARGIN ? ";
  1582.  COLOR FldColor MOD 16, FldColor \ 16
  1583.  CALL ENTERNUMBER (Marg#, "#", Msg$)
  1584.  IF Msg$ <> "CR" THEN RETURN MainMenu
  1585.  Margin = MIN (CINT(Marg#), 3)
  1586.  
  1587.  COLOR ScrColor MOD 16, ScrColor \ 16
  1588.  LOCATE 16,5: PRINT "HOW LONG SHALL WE MAKE THE TEXT LINES ? ";
  1589.  COLOR FldColor MOD 16, FldColor \ 16
  1590.  CALL ENTERNUMBER (LinL#, "###", Msg$)
  1591.  IF Msg$ <> "CR" THEN RETURN MainMenu
  1592.  
  1593.  DO
  1594.    COLOR ScrColor MOD 16, ScrColor \ 16
  1595.    LOCATE 18,5: PRINT " ... AND HOW MANY LINES ? ";
  1596.    COLOR FldColor MOD 16, FldColor \ 16
  1597.    CALL ENTERNUMBER (LinsNum#, "###", Msg$)
  1598.    IF Msg$ <> "CR" THEN RETURN MainMenu
  1599.  LOOP UNTIL LinsNum# > 0
  1600.  
  1601.  TenChr$ = "<Ten Chrs>"
  1602.  Digital$ = "123456789"
  1603.  N = INT (LinsNum#)
  1604.  L = INT (LinL#)
  1605.  Text4Box$ = REPEAT$ (L \ 10, TenChr$) + LEFT$ (Digital$, L MOD 10)
  1606.  DIM DYNAMIC T$ (1:N)
  1607.  FOR I = 1 TO N
  1608.    T$(I) = Text4Box$
  1609.  NEXT
  1610.  
  1611.     CALL BOXMESSAGE2 (CINT (CLin#), CINT (CCol#), Margin, T$(), N, L)
  1612.  
  1613.  CALL PressAKey
  1614.  CLS
  1615.  ERASE T$
  1616.  RETURN
  1617.  
  1618. QBoxTest:
  1619.  COLOR ScrColor MOD 16, ScrColor \ 16
  1620.  CLS
  1621.  CALL QBox (3, %Center, 1, "DEMO OF DIALOG BOX (TRY TO MAKE IT FAIL!)", 0)
  1622.  FOR Oof = 1 TO 80 STEP 10: LOCATE 1, Oof: PRINT "|";: NEXT
  1623.  
  1624.  COLOR ScrColor MOD 16, ScrColor \ 16
  1625.  LOCATE 10, 50: PRINT "... 0 = Horiz. Centered Box"
  1626.  LOCATE 10,5: PRINT "LEFT UPPER CORNER AT COLUMN ";
  1627.  COLOR FldColor MOD 16, FldColor \ 16
  1628.  CALL ENTERNUMBER (CCol#, "###", Msg$)
  1629.  IF Msg$ <> "CR" THEN RETURN MainMenu
  1630.  
  1631.  COLOR ScrColor MOD 16, ScrColor \ 16
  1632.  LOCATE 12, 50: PRINT "... 0 = Vert. Centered Box"
  1633.  LOCATE 12,5: PRINT "LEFT UPPER CORNER AT ROW ";
  1634.  COLOR FldColor MOD 16, FldColor \ 16
  1635.  CALL ENTERNUMBER (CLin#, "###", Msg$)
  1636.  IF Msg$ <> "CR" THEN RETURN MainMenu
  1637.  
  1638.  Lins# = INT (Lins#)
  1639.  COLOR ScrColor MOD 16, ScrColor \ 16
  1640.  LOCATE 14,5: PRINT " ONE LINE BOX OR THREE LINE BOX ?? ";
  1641.  COLOR FldColor MOD 16, FldColor \ 16
  1642.  L = CSRLIN: C = POS
  1643.  DO
  1644.    LOCATE L, C
  1645.    Lins$ = " "
  1646.    CALL ENTERSTRING (Lins$, 1, Msg$)
  1647.    Lins = VAL (Lins$)
  1648.  LOOP UNTIL Lins = 1 OR Lins = 3
  1649.  IF Msg$ <> "CR" THEN RETURN MainMenu
  1650.  
  1651.  COLOR ScrColor MOD 16, ScrColor \ 16
  1652.  LOCATE 16,5: PRINT "ENTER TEXT LINE: ";
  1653.  COLOR FldColor MOD 16, FldColor \ 16
  1654.  IF Prompt$ = "" then Prompt$ = "Sample Prompt"
  1655.  CALL ENTERSTRING (Prompt$, 40, Msg$)
  1656.  IF Msg$ <> "CR" THEN RETURN MainMenu
  1657.  
  1658.  COLOR ScrColor MOD 16, ScrColor \ 16
  1659.  LOCATE 18,5: PRINT "LENGTH OF ANSWER FIELD ? ";
  1660.  COLOR FldColor MOD 16, FldColor \ 16
  1661.  CALL ENTERNUMBER (AFL#, "##", Msg$)
  1662.  IF Msg$ <> "CR" THEN RETURN MainMenu
  1663.  
  1664.  
  1665.  AnsLength = CINT (AFL#)
  1666.  
  1667.     CALL QBox (CINT (CLin#), CINT (CCol#), Lins, Prompt$, AnsLength)
  1668.  
  1669.  DELAY 2
  1670.  COLOR FldColor MOD 16, FldColor \ 16
  1671.  FOR I = 1 TO AnsLength
  1672.    PRINT " ";
  1673.    DELAY .03
  1674.  NEXT
  1675.  DELAY 1
  1676.  CALL PressAKey
  1677.  COLOR ScrColor MOD 16, ScrColor \ 16
  1678.  CLS
  1679.  RETURN
  1680.  
  1681. '     ==================================================================
  1682. PrintDoc:
  1683.  
  1684.  FileError = %False
  1685.  N = 1
  1686.  TopMargin = 4
  1687.  BottomMargin = 6
  1688.  IF NOT ColorDisplay THEN COLOR ScrColor MOD 16, ScrColor \ 16
  1689.  CLS
  1690.  CALL QBox (4, %Center, 1, "PRINTING DOCUMENTATION FILE", 0)
  1691.  Header$ = ItalicPrtOn$ + _
  1692.       " ALL-PURPOSE LIBRARY: THE DOC FILE (paginated automtically) Page " + _
  1693.                                                                   ItalicPrtOff$
  1694.  Footer$ = ""
  1695.  
  1696.  L$ = "START"
  1697.  CALL PRINTLINE (L$) '           Init printing -- disk or PRN -- and check
  1698.  
  1699.  IF L$ <> "ABORTED BY USER" THEN
  1700.  
  1701.    CALL SCREENPUSH
  1702.    LOCATE 13, 1
  1703.    IF NOT ColorDisplay THEN COLOR ScrColor MOD 16, ScrColor \ 16
  1704.    
  1705. PRINT "                                                                           "
  1706. PRINT "  NOTE: You may want to set your printer's front panel controls for the    "
  1707. PRINT "        font you prefer now. This routine sends no control codes to the    "
  1708. PRINT "        printer except some Esc-4 and Esc-5's to italicize the header,     "
  1709. PRINT "        so the printed output will be in the default font of your printer  "
  1710. PRINT "        otherwise.                                                         "
  1711. PRINT "                                                                           "
  1712. PRINT "        The All Purpose Library DOES support printer codes if you set it   "
  1713. PRINT "        up for your printer -- see the procedure Initialize ().            "
  1714. PRINT "                                                                           "
  1715. PRINT "                       CLICK A BUTTON OR PRESS A KEY TO START PRINTING.    "
  1716.  
  1717.    GOSUB ClickOrStrike
  1718.    CALL SCREENPOP
  1719.    IF NOT ColorDisplay THEN COLOR ScrColor MOD 16, ScrColor \ 16
  1720.  
  1721.      File2View$ ="APLIB.DOC"
  1722.      IF EXIST (File2View$) THEN '              uses function EXIST () ...
  1723.        TxtFile = FREEFILE '                    gets an available handle # ...
  1724.        OPEN File2View$  FOR INPUT AS #TxtFile
  1725.        Ln = 0
  1726.        LOCATE 15,30: PRINT Esc2Q$
  1727.        DO UNTIL EOF (TxtFile) OR FileError '             and views the file.
  1728.          LINE INPUT #1, L$
  1729.          INCR Ln
  1730.          LOCATE 12,20
  1731.          PRINT USING "PRINTING PAGE ## LINE ## ..."; Page%, CurrLine
  1732.          CALL PRINTLINE (L$)
  1733.          IF L$ = "ABORTED BY USER" THEN EXIT LOOP
  1734.        LOOP
  1735.        CALL PRINTLINE (CHR$ (12))
  1736.        If SoundOn THEN PLAY ArribaBeep$
  1737.        CLOSE '                                     close both files if 2 open
  1738.        PLAY "L64 O2 C E G O3 C E G O4 C"
  1739.      ELSE
  1740.        CALL QBox (10,30,1,"DID NOT FIND FILE " + File2View$, 0)
  1741.      END IF
  1742.    CALL PressAKey
  1743.    CLS
  1744.  END IF
  1745.  RETURN
  1746.  
  1747.  
  1748.  ' ((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((
  1749.  
  1750. MOFiles:
  1751.  NextScrn2Pop = MainMenuScreen
  1752.  CALL SCREENPOP
  1753.  HomeDrive$ = GetCurrentDrive$
  1754.  HomeDirec$ = CURDIR$ ("")
  1755.  D2Search$ = PICKADIR$
  1756.  IF D2Search$ = "" THEN RETURN
  1757.  CALL QBox (4, 1, 1, CHR$(34) + D2Search$ + CHR$(34), 0)
  1758.  F$ =  PICKAFILE$ (D2Search$)
  1759.  IF F$ <> "" THEN
  1760.    INCR NextScrn2Pop
  1761.    CALL SCREENPOP
  1762.    CALL DirFirst (F$, FileSize&, DateCode&, TimeCode&)
  1763.  
  1764.                              $INCLUDE "FILEDATA.INC"
  1765.  
  1766.  END IF
  1767.  CALL PressAKey
  1768.  RETURN
  1769.  
  1770. ScreenBlank:
  1771.  RANDOMIZE TIMER
  1772.  IF ColorDisplay THEN COLOR (17 + 5*RND), 0 _
  1773.                  ELSE COLOR %Gry + 16, %Blk
  1774.  CLS '                                              clear screen ...
  1775.  L = MAX ((21*RND), 1)
  1776.  C = 25 + 20 * RND
  1777.  LOCATE L, C, 0: PRINT "zzz ..."'                    ... and take a nap
  1778.  GOSUB ClickOrStrike  '                          ... until click or keystroke.
  1779.  GOTO MainMenu
  1780.  
  1781. HelpWindow:
  1782.  
  1783.  CALL SCREENPUSH
  1784.  CALL BOXMESSAGE (%Center, %Center, 1)
  1785.  GOSUB ClickOrStrike
  1786.  CALL SCREENPOP
  1787.  COLOR FldColor MOD 16, FldColor \ 16
  1788.  RETURN
  1789.  
  1790. MainMenuHelp:
  1791.  DATA Press [E] for DEMO OF A DATA ENTRY WINDOW and the various formatted entry
  1792.  DATA "   Procedures in the All Purpose PB Programmers' Library. A window will
  1793.  DATA "   open onscreen and you can play w/ pick-list, string, number, date and
  1794.  DATA "   yes-or-no entries. It's a fake checking-program entry window.
  1795.  DATA ""
  1796.  DATA Press [F] for file commands  -- you can list the source code file or the
  1797.  DATA "   documentation file to the screen;  send the doc to your printer all
  1798.  DATA "   neatly paginated and stuff ... or shell out to DOS."
  1799.  DATA ""
  1800.  DATA "The [M] menu has four or five demonstrations of SUPERMENU including"
  1801.  DATA "    multi-page menus, PICKADIR$, and PICKAFILE$"
  1802.  DATA ""
  1803.  DATA "PRESS [O] for a few other doodads -- the Beep Development Environment,"
  1804.  DATA "    the exhaustive demo of Entry Modes, the Guess-your-Age Routine.
  1805.  DATA ""
  1806.  DATA THE QUIT MENU (Press Q) IS ALSO USED TO SWITCH SOME PROGRAM FUNCTIONS
  1807.  DATA ""
  1808.  DATA "        BUTTONS: the first 3 are dummies / the 4th works;
  1809.  DATA "                    type ALT-X or use the plastic pest to click on it
  1810.  DATA ""
  1811.  DATA " (to go on, press something)"
  1812.  DATA END
  1813.  
  1814. '' ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  1815. '' ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  1816.  
  1817.                            $INCLUDE "APLIB-F.BAS"
  1818.  
  1819.